Exclusions

# table(full_pdf$obligatory_check)
pdf = full_pdf %>% 
    filter(obligatory_check == "correct") %>% 
    mutate(
        subj = row_number(),
        control = factor(control, levels=c("low", "high"))
    )

pdf2 = select(pdf, wid, subj, control)

unk_df = full_df %>% 
    right_join(pdf2) %>%  # also drops excluded participants
    filter(scenario != "PRACTICE") %>%
    group_by(wid) %>% 
    mutate(
        scenario = tolower(scenario),
        evaluation_z = zscore(evaluation),
        abs_eval = abs(evaluation),
        abs_eval_z = zscore(abs_eval),
        consideration=if_else(considered, "considered", "unconsidered")
    ) %>% 
    ungroup()

df = filter(unk_df, outcome != "UNK")
n_drop = nrow(full_pdf) - nrow(pdf)
n_drop_unk = nrow(unk_df) - nrow(df)
n_trial = nrow(df)

scenarios = full_scenarios %>%
    right_join(pdf2)  %>% 
    filter(scenario != "PRACTICE") %>%
    group_by(wid) %>% 
    mutate(
        scenario = tolower(scenario),
        scenario_evaluation_z = zscore(scenario_evaluation),
        trial_number = row_number(),
    ) %>% 
    ungroup()

df = left_join(df, select(scenarios, wid, scenario, scenario_evaluation, scenario_evaluation_z))

We exclude 1 participant(s) who answered the comprehension check incorrecttly (incorrect = saying that you can not take the outcome if you don’t like it), resulting in 54 participants.

We exclude 103 outcomes which were considered but not in the original set, resulting in 2677 observations. This was not my orginal plan, but I think this is the correct thing to do. See Out-of-set outcomes for an explanation.

Consideration probability by outcome value

How does the probability of an item being included in the considered set depend on its value (measured by post-decision rating)?

# BASELINE = mean(df$evaluation)

df %>% 
    ggplot(aes(evaluation, as.numeric(considered), color=control)) +
    stat_summary_bin(fun.data=mean_cl_boot, bins=5, alpha=0.5, 
                     position=position_dodge(width=.5)) +
    stat_smooth(geom="line", size=0.8, linetype = "dotted", alpha=0.5) +
    # geom_smooth(se=F, method=lm, formula=y ~ x + abs(x), alpha=0.1) +
    geom_smooth(se=F, method=glm, 
        formula=y ~ x + abs(x),
        method.args = list(family = "binomial"),
        alpha=0.1) +
    ylab("consideration probability") +
    control_colors

Reading the plot: points show binned means with 95% CI error bars. The dashed line shows a non-parameteric GAM fit. The solid line shows a logistic regression of the form \(\text{logit}(y) = \beta_0 + \beta_1 x + \beta_2 |x|\). This is an adaptation of the earlier apples/oranges version of our model.

Mixed-effects regression with random interecepts and slopes for signed and absolute value:

consideration_model = df %>% 
    glmer(considered ~ control * (evaluation + abs(evaluation)) + (evaluation + abs(evaluation) | wid),
     family=binomial, data=.)

plot_coefs(consideration_model, omit.coefs=c("controlhigh", "(Intercept)"), colors="black") #plot

summ(consideration_model)

The key predictions are confirmed:

• Both groups are more likely to consider extreme outcomes.
• Only the high-control group is more likely to consider positive outcomes.

We also see an unexpected trend (not quite significant) that the low-control group preferentially considers negative outcomes. I can think of two possible explanations for this

1. People aren’t using the scale in a symmetric way; specifically, negative ratings are actually more extreme than the opposite positive ratings.
2. People are biased towards sampling bad things.

Explanation (2) is a much more interesting explanation as it violates the prediction of the rational model—at least, as it is currently posed. However, (1) is also very plausible, so we would want to rule that out before interpreting this finding too much.

How can we ensure that people are using the scale symmetrically? One strategy is to add a phase at the end of the experiment where participants evaluate pairs of outcomes. We pick out specific outcomes that they evaluated as (roughtly) opposite around 0 and ask if they would be willing to have the bad thing happen if the good thing would also happen. If (1) is correct, then people will give respond no more than half the time. This feels not all that convincing and kind of complicated to me though.

👉 Do we want to add anything to the experiment to check whether participants are using the scale non-symetrically?

(I’m tagging action/discussion items with the 👉 emoji)

wrap_scenario = list(
    facet_wrap(~scenario, dir="v", ncol=4),
    theme(strip.text.x = element_text(size=12), legend.position="top")
)

df %>% 
    ggplot(aes(evaluation, as.numeric(considered), color=control)) +
    stat_summary_bin(fun.data=mean_cl_boot, bins=5, alpha=0.5, 
                     position=position_dodge(width=.5)) +
    geom_smooth(se=F, method=glm, 
        formula=y ~ x + abs(x - 0),
        method.args = list(family = "binomial"),
        alpha=0.1) +
    ylab("consideration probability") +
    control_colors + wrap_scenario

Value distributions

To better understand the effect of scenario, we need to look at the underlying distributions of outcome values. Here we are plotting the distribution of all outcome values in gray and the distribution of considered outcomes in blue and yellow.

df %>% 
    ggplot(aes(evaluation, y=..prop..)) + 
    geom_bar(alpha=1, fill="gray50", position="identity") +
    geom_bar(aes(fill=control), data=filter(df, considered), alpha=0.7, position="identity") +
    control_colors + wrap_scenario + 
    labs(fill="considered by", y="proportion")

It’s hard to know what to make of this. Ideally, there would be some systematic relationship between the distribution of outcome values (gray) and consideration. But I don’t really see that.

For example, consider sports (silence) and vehicles (veto). These have very similar value distributions, but totally different consideration profiles. However, my intuition suggests that these situations don’t really have similar value distributions. Silencing a sport could actually be positive, but being banned from using some mode of transportation is pretty much strictly negative. This makes me think that people are using the scale in a relative way, such that +5 means “given that you are going to have to give up some mode of transport, boats would be a pretty good option.”

The problem is that the model won’t be able to do this kind of reasoning. It’s possible that the total scenario evaluation could provide some information here, but I’m not sure how exactly that would work. I see two reasonable paths here:

1. Give up on the idea of making scenario-specific predictions with this paradigm. Use this paradigm to show the high-level prediction (the first plot) and then move to a paradigm with experimentally manipulated values to test the model at a finer level of granularity.
2. Use a different experimental strategy to get absolute evaluations. For example, rather than grouping evaluations by scenario (which encourages scenario-dependent valuation), we could do all the evaluations at the end of the experiment, after they’ve rated each scenario.

👉 Do we want to make scenario-specific predictions? If so, how can we get ratings that are consistent across scenarios?

Tricky nuances

unk_df %>% 
    filter(considered) %>% 
    group_by(scenario) %>% 
    mutate(out=outcome=="UNK") %>% 
    summarise(n=sum(out), prop=mean(out)) %>% kable(digits=2)

df %>% 
    ggplot(aes(evaluation, y=..prop.., fill=control)) + 
    geom_bar(alpha=0.7, position="identity") +
    control_colors + wrap_scenario +
    labs(fill="evaluated by", y="proportion")

df %>% 
    mutate(scenario = fct_reorder(scenario, evaluation)) %>% 
    ggplot(aes(scenario, y=evaluation, color=control)) + 
    # geom_quasirandom(dodge.width=.8, size=.1) +
    # geom_boxplot(position=position_dodge(width=.5)) +
    stat_summary(fun.data=mean_cl_boot, position=position_dodge(width=.5)) +
    control_colors + coord_flip()

Discussion

I’ve highlighted specific action items above. Here they are again:

• Do we want to add anything to the experiment to check whether participants are using the scale non-symetrically?
• Do we want to make scenario-specific predictions? If so, how can we get ratings that are consistent across scenarios?
• In the next pilot, I think we should not even collect evaluations for out-of-sample outcomes. This ensures that everyone rates the exact same set of outcomes.
• Is it okay to have many out-of-set considered options? Or do we need to adjust our stimuli?
• Is it okay that the value distributions vary systematically by condition?

A theme across several of these is that participants are likely not giving outcome ratings on an absolute scale. If we are going to do any interesting modeling, we will need to either resolve this issue or move to a paradigm in which we can objectively quantify (and ideally manipulate) outcome value. I think for CogSci, we are probably fine with the basic qualitative effect, but if there are any easy things we can try, it’s probably worth a shot.

Quality/sanity checks

slider = full_slider %>% right_join(pdf2) %>% rename(evaluation="response")

slider %>% 
    mutate(prompt = fct_reorder(prompt, evaluation)) %>% 
    ggplot(aes(prompt, evaluation)) +
    # geom_quasirandom(size=.8) +
    geom_line(aes(group=wid), alpha=0.5, size=0.5) +
    stat_summary(fun.data=mean_cl_boot, color="red") +
    coord_flip() + xlab("")

slider %>% 
    mutate(wid = fct_reorder(wid, evaluation, .fun=sd)) %>% 
    ggplot(aes(wid, evaluation)) +
    stat_summary(fun.data=mean_sdl) +
    scale_x_discrete(breaks=NULL) +
    xlab("participant")

scenarios %>% 
    ggplot(aes(scenario, scenario_evaluation, color=control)) +
    stat_summary(fun.data=mean_cl_boot, position=position_dodge(width=.35)) +
    # geom_quasirandom(size=.8, dodge.width=.8, alpha=0.5) + 
    control_colors + coord_flip()

scenarios %>% lmer(scenario_evaluation ~ control + (1|wid) + (1|scenario), data=.) %>% summ

full_scenarios %>% 
    group_by(wid) %>% 
    mutate(trial_number = row_number()-1) %>%
    ungroup() %>% 
    right_join(pdf2) %>% 
    ggplot(aes(trial_number, scenario_evaluation, color=control)) +
    stat_summary(fun.data=mean_cl_boot, position=position_dodge(width=.35)) +
    # geom_quasirandom(size=.8, dodge.width=.8, alpha=0.5) + 
    control_colors

library(ggpubr)
df %>% 
    ggplot(aes(evaluation, scenario_evaluation)) +
    geom_point(size=.3, alpha=.5, position="jitter") + 
    # geom_bin_2d(breaks=seq(-10.5, 10.5)) + 
    geom_smooth(method="lm", se=F) +
    stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01, label.y=11.5) +
    ylim(-10, 12) +
    facet_wrap(~consideration)

df %>% 
    ggplot(aes(evaluation, scenario_evaluation, color=consideration)) +
    geom_point(size=.3, alpha=.5, position="jitter") + 
    wrap_scenario + considered_colors +
    geom_smooth(method="lm", se=F)

lmer(scenario_evaluation ~ evaluation * considered + (evaluation*considered|wid) + (1|scenario), data=df) %>% summ

scenarios %>% 
    ggplot(aes(n_considered, fill=control, y=..prop..)) + 
    geom_bar(position="identity", alpha=0.6) + control_colors